home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / bbsutil / dlx70bbs.zip / DLX70SRC.ZIP / PMSTATS.PAS < prev    next >
Pascal/Delphi Source File  |  1994-02-08  |  12KB  |  405 lines
  1. {$debug+}
  2. {$line+}
  3.  
  4. {$include: 'types.int'}
  5. {$include: 'globals.int'}
  6.  
  7. program PMSTATS(input,output);
  8.  
  9. {
  10.  Pubmail Statistics Program for DLX
  11.  Richard Gillmann, February 1993
  12.  
  13.  To Build: pl /c pmstats.pas
  14.         link pmstats+globals,,,/NOD/EXEPACK libpasa;
  15. }
  16.  
  17. {DLX Bulletin Board System V7.0
  18.  
  19.  FREEWARE NOTICE
  20.  
  21.  DLX V7.0 is placed in the public domain by its author, Richard Gillmann.
  22.  Anyone who wishes to may run the program, copy it, or modify it for
  23.  any purpose, including commercial gain.}
  24.  
  25. USES types,globals;
  26.  
  27. {***Special for calling file initialize module***}
  28. procedure globals; EXTERN;
  29.  
  30. {***Interface to MS Pascal library***}
  31. procedure date(var s : string); EXTERN;
  32. function getmqq(wants : word) : adsmem; EXTERN;
  33.  
  34. const
  35.   max_members = 4400;
  36.   tab = chr(9);
  37.  
  38. type
  39.   member_info_record = record
  40.     handle : lstring(5);
  41.     user_level : char;
  42.     sex : char;
  43.     sexpref : char;
  44.     married : char;
  45.     age : integer;
  46.     posts : integer;
  47.   end {member_index_record};
  48.   member_info_array = array [1..max_members] of member_info_record;
  49.   ads_mif = ads of member_info_array;
  50.  
  51. {strip trailing blanks and comments}
  52. procedure stripc(var str : lstring);
  53. var
  54.   i : integer;
  55. begin
  56.   for i:=1 to ord(str.len) do
  57.     if str[i]=chr(0) or else str[i]='{' then
  58.       [str.len:=wrd(i-1); break];
  59.   for i:=ord(str.len) downto 1 do
  60.     if str[i]=' ' or else str[i]=tab then str.len:=str.len-1 else break;
  61. end {stripc};
  62.  
  63. function date2jd(consts dd : string) : integer4;
  64. var
  65.   c,ya : integer4;
  66.   month,day,year,temp : integer;
  67.   w : word;
  68. begin
  69. {get raw date}
  70.   month:=(ord(dd[1])-ord('0'))*10 + (ord(dd[2])-ord('0'));
  71.   day  :=(ord(dd[4])-ord('0'))*10 + (ord(dd[5])-ord('0'));
  72.   year :=(ord(dd[7])-ord('0'))*10 + (ord(dd[8])-ord('0'));
  73. {process}
  74.   if year>=80
  75.     then year:=year+1900
  76.     else year:=year+2000;
  77.   if month > 2 then
  78.     month := month - 3
  79.   else begin
  80.     month := month + 9;  year := year - 1;
  81.   end {else};
  82.   c := year div 100;
  83.   ya := year mod 100;
  84.   date2jd := ((146097*c) div 4) + ((1461*ya) div 4) +
  85.              ((153*month + 2) div 5) + day + 1721119;
  86. end {date2jd};
  87.  
  88. function r(x : real) : integer;
  89. begin
  90.   r := trunc(x+0.5);
  91. end;
  92.  
  93. var
  94.   lstr : lstring(255);
  95.   BoardName : array [1..50] of lstring(24);
  96.   BoardInfo : array [1..50,1..12] of integer;
  97.   bb : integer; {number of pubs}
  98.   ll : integer; {top "n" (10 if lots)}
  99.  
  100. procedure SortLemma(k : integer);
  101. var
  102.   i,j,Temp,l : integer;
  103. begin
  104.   for i:=1 to bb do
  105.     for j:=i+1 to bb do
  106.       if BoardInfo[i][k] < BoardInfo[j][k] then
  107.         [copylst(BoardName[i],lstr);
  108.      copylst(BoardName[j],BoardName[i]);
  109.      copylst(lstr,BoardName[j]);
  110.      for l:=1 to 12 do
  111.        [Temp:=BoardInfo[i][l];
  112.         BoardInfo[i][l]:=BoardInfo[j][l];
  113.         BoardInfo[j][l]:=Temp]];
  114. end {SortLemma};
  115.  
  116. procedure SortBy(k : integer);
  117. var
  118.   i : integer;
  119. begin
  120.   SortLemma(k);
  121.   for i:=1 to ll do
  122.     writeln(BoardInfo[i][k]:4,' ',BoardName[i]:-24,'  ',
  123.             BoardInfo[bb-i+1][k]:4,' ',BoardName[bb-i+1]:-24);
  124.   writeln;
  125. end {SortBy};
  126.  
  127. var
  128.   when,now : lstring(8);
  129.   jdWhen,jdNow,jdOldest : integer4;
  130.   member_info : ads_mif;
  131.   i,n : integer;
  132.   pm : pubmail_record;
  133.   nMsgs,nLastMonth,nValid : integer;
  134.   nPosters,nSub,nMen,nStr,nSgl : integer;
  135.   SubTotal, TotalAge : integer4;
  136.   nTopPosts, nTopPoster : integer;
  137.   nTop2Posts, nTop2Poster : integer;
  138.  
  139. begin
  140. {open members and pubmail files}
  141.   globals;{pascal file system}
  142.   assign(f_members,'members');
  143.   reset(f_members);
  144.   assign(f_pubmail,'pubmail');
  145.   reset(f_pubmail);
  146.  
  147. {print herald}
  148.   writeln('Public Mail Statistics');
  149.   now.len:=8; date(now);
  150.   jdNow:=date2jd(now);
  151.   now[3]:='/'; now[6]:='/';
  152.   writeln(now:8);
  153.   writeln;
  154.  
  155. {malloc memory}
  156.   mbi:=sizeof(member_info^[1])*max_members;
  157.   member_info:=getmqq(mbi);
  158.  
  159. {read the members file}
  160.   n:=0;
  161.   while not eof(f_members) and then n<max_members do begin
  162.     readln(f_members,member_internal_buffer);
  163.     n:=n+1;
  164.     movel(adr member_internal_buffer,adr member_buffer,member_length);
  165.     member_info^[n].handle.len:=5;
  166.     for i:=1 to 5 do
  167.       member_info^[n].handle[i]:=member_buffer.name[i];
  168.     member_info^[n].user_level:=member_buffer.userlevel[1];
  169.     member_info^[n].sex:=member_buffer.gender[1];
  170.     member_info^[n].sexpref:=member_buffer.pref[1];
  171.     member_info^[n].married:=member_buffer.mult_answer[1][4];
  172.     lstr.len:=3;
  173.     for i:=1 to 3 do
  174.       lstr[i]:=member_buffer.age[i];
  175.     eval(decode(lstr,i));
  176.     member_info^[n].age:=i;
  177.     member_info^[n].posts:=0;
  178.   end {while};
  179.   close(f_members);
  180.  
  181. {print the table headings}
  182.   writeln('                       #  Msg Last Post  %   %   %   %   %  Avg');
  183.   writeln('C Board Title         Msg /Mo Mnth -ers Mod Sub Men Str Sgl Age Top Posters');
  184.   writeln('- -----------         --- --- ---- ---- --- --- --- --- --- --- -----------');
  185.  
  186. {read the pubmail file}
  187.   bb:=0;
  188.   while not eof(f_pubmail) do begin
  189.  
  190. {get title, letter, mod#}
  191.     readln(f_pubmail,lstr); stripc(lstr);
  192.     if lstr.len>24 then lstr.len:=24;
  193.     copystr(lstr,pm.name);
  194.     bb:=bb+1;
  195.     copylst(lstr,BoardName[bb]);
  196.     readln(f_pubmail,pm.letter);
  197.     readln(f_pubmail,pm.memberid);
  198.     if pm.memberid>n then
  199.       pm.memberid:=0;
  200.     readln(f_pubmail);
  201.     readln(f_pubmail);
  202.     readln(f_pubmail);
  203.     readln(f_pubmail,pm.anon);
  204.     readln(f_pubmail);
  205.     readln(f_pubmail);
  206.     readln(f_pubmail);
  207.     readln(f_pubmail);
  208.     readln(f_pubmail);
  209.     readln(f_pubmail);
  210.     readln(f_pubmail);
  211.     if not eof(f_pubmail) then
  212.       readln(f_pubmail,lstr);
  213.  
  214. {for each category}
  215.     nMsgs:=0; nValid:=0;
  216.     nLastMonth:=0;
  217.     jdOldest:=0;
  218.  
  219. {clear posts counters}
  220.     for i:=1 to n do
  221.       member_info^[i].posts:=0;
  222.  
  223. {read the index file}
  224.     copylst('PUB-BOX\INDEX',lstr); concat(lstr,pm.letter);
  225.     f_index.trap:=true; f_index.errs:=0;
  226.     assign(f_index,lstr); reset(f_index);
  227.     while (f_index.errs=0) and then (not eof(f_index)) do begin
  228.       readln(f_index,index_internal_buffer);
  229.       movel(adr index_internal_buffer,adr index_buffer,index_length);
  230.  
  231. {find out who posted each message}
  232.       copylst(index_buffer.msg_from,lstr);
  233.       for i:=ord(lstr.len) downto 1 do
  234.         if lstr[i]=' '
  235.       then lstr.len:=wrd(i-1)
  236.       else break;
  237.       while lstr[1]<'0' or else lstr[1]>'9' do
  238.         delete(lstr,1,1);
  239.       eval(decode(lstr,i));
  240.  
  241. {total posts/caller, #msgs, #msgs last month, oldest msg}
  242.       if i>4 and then i<=n then begin
  243.         member_info^[i].posts:=member_info^[i].posts+1;
  244.     nMsgs:=nMsgs+1;
  245.     for i:=1 to 8 do
  246.       when[i]:=index_buffer.date[i];
  247.     when.len:=8;
  248.     jdWhen:=date2jd(when);
  249.     if jdOldest=0 then
  250.       jdOldest:=jdWhen;
  251.     if (jdWhen+30) >= jdNow then
  252.           nLastMonth:=nLastMonth+1;
  253.       end {if};
  254.       
  255.     end {while};
  256.     close(f_index);
  257.  
  258. {go thru member array, compute stats}
  259.     nPosters:=0;
  260.     nSub:=0;
  261.     nMen:=0;
  262.     nStr:=0;
  263.     nSgl:=0;
  264.     TotalAge:=0;
  265.     nTopPosts:=0;
  266.     nTopPoster:=0;
  267.     nTop2Posts:=0;
  268.     nTop2Poster:=0;
  269.     for i:=5 to n do if member_info^[i].posts>0 then begin
  270.       nValid:=nValid+member_info^[i].posts;
  271.       nPosters:=nPosters+1;
  272.       if member_info^[i].user_level>'3' then
  273.     nSub:=nSub+member_info^[i].posts;
  274.       if member_info^[i].sex='M' then
  275.     nMen:=nMen+member_info^[i].posts;
  276.       if member_info^[i].sexpref='S' then
  277.     nStr:=nStr+member_info^[i].posts;
  278.       if member_info^[i].married='S' then
  279.     nSgl:=nSgl+member_info^[i].posts;
  280.       SubTotal := member_info^[i].posts;
  281.       SubTotal := SubTotal * member_info^[i].age;
  282.       TotalAge := TotalAge + SubTotal;
  283.       if pm.memberid<>i then begin
  284.         if member_info^[i].posts>nTopPosts then
  285.           [nTop2Posts:=nTopPosts;
  286.        nTop2Poster:=nTopPoster;
  287.        nTopPosts:=member_info^[i].posts;
  288.        nTopPoster:=i]
  289.         else if member_info^[i].posts>nTop2Posts then
  290.           [nTop2Posts:=member_info^[i].posts;
  291.        nTop2Poster:=i];
  292.        end {if not moderator};
  293.      end {for if};
  294.  
  295. {print line of stats}
  296.     for i:=1 to 12 do BoardInfo[bb][i]:=0;
  297.     write(pm.letter:-2);
  298.     write(pm